home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tptool.lbr / CHAPTER1.PQS / chapter1.pas
Pascal/Delphi Source File  |  1985-06-03  |  3KB  |  144 lines
  1. {$A-}
  2. program chapter1;
  3. {$I TOOLU.PAS}
  4. {  Note:  X$ disables the include file }
  5. {X$I OS-CPM80.PAS       <--  CP/M-80 users include this file }
  6. {X$I OS-CPM86.PAS       <--  CP/M-86 users include this file }
  7. {X$I OS-MSDOS.PAS       <--  MS-DOS v 2 users include this file  }
  8. {$I OS-OTHER.PAS       <--  MS-DOS v 1 and all others }
  9.  
  10. { OS support is not in chapter1 of K&P, but this is a good place to add it }
  11.  
  12.  
  13. PROCEDURE COPY;
  14. VAR C:CHARACTER;
  15. BEGIN
  16.   WHILE(GETC(C)<>ENDFILE)DO
  17.     PUTC(C)
  18. END;
  19.  
  20.  
  21. PROCEDURE CHARCOUNT;
  22. VAR
  23.   NC:INTEGER;
  24.   C:CHARACTER;
  25. BEGIN
  26.   NC:=0;
  27.   WHILE (GETC(C)<>ENDFILE)DO
  28.      NC:=NC+1;
  29.   PUTDEC(NC,1);
  30.   PUTC(NEWLINE)
  31. END;
  32.  
  33. PROCEDURE LINECOUNT;
  34. VAR
  35.   N1:INTEGER;
  36.   C:CHARACTER;
  37. BEGIN
  38.   N1:=0;
  39.   WHILE(GETC(C)<>ENDFILE)DO
  40.     IF(C=NEWLINE)THEN
  41.       N1:=N1+1;
  42.   PUTDEC(N1,1);
  43.   PUTC(NEWLINE)
  44. END;
  45.  
  46. PROCEDURE CallShell;
  47. { read first line of STDIN, put in process queue }
  48. { W. Kempton -- 5 Jan 85 }
  49. begin
  50.   if ActiveProcessQ then
  51.      ERROR('Shell: Processes already queued -- aborted');
  52.   ActiveProcessQ := GETLINE(ProcessQueue,STDIN,MAXSTR);
  53. end;
  54.  
  55.  
  56.  
  57. PROCEDURE WORDCOUNT;
  58. VAR
  59.   NW:INTEGER;
  60.   C:CHARACTER;
  61.   INWORD:BOOLEAN;
  62. BEGIN
  63.   NW:=0;
  64.   INWORD:=FALSE;
  65.   WHILE(GETC(C)<>ENDFILE)DO
  66.     IF(C=BLANK)OR(C=NEWLINE)OR(C=TAB) THEN
  67.       INWORD:=FALSE
  68.     ELSE IF (NOT INWORD)THEN BEGIN
  69.       INWORD:=TRUE;
  70.       NW:=NW+1
  71.     END;
  72.   PUTDEC(NW,1);
  73.   PUTC(NEWLINE)
  74. END;
  75.  
  76. PROCEDURE DETAB;
  77. CONST
  78.   MAXLINE=1000;
  79. TYPE
  80.   TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
  81. VAR
  82.   C:CHARACTER;
  83.   COL:INTEGER;
  84.   TABSTOPS:TABTYPE;
  85.  
  86. FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE)
  87.   :BOOLEAN;
  88. BEGIN
  89.   IF(COL>MAXLINE)THEN
  90.     TABPOS:=TRUE
  91.   ELSE
  92.     TABPOS:=TABSTOPS[COL]
  93. END;
  94.  
  95. PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
  96. CONST
  97.   TABSPACE= TabSpaces ;    { was 4 in K&P }
  98. VAR
  99.   I:INTEGER;
  100. BEGIN
  101.   FOR I:=1 TO MAXLINE DO
  102.     TABSTOPS[I]:=(I MOD TABSPACE = 1)
  103. END;
  104.  
  105. BEGIN
  106.   SETTABS(TABSTOPS);
  107.   COL:=1;
  108.   WHILE(GETC(C)<>ENDFILE)DO
  109.     IF(C=TAB)THEN
  110.      REPEAT
  111.       PUTC(BLANK);
  112.       COL:=COL+1
  113.      UNTIL(TABPOS(COL,TABSTOPS))
  114.     ELSE IF(C=NEWLINE)THEN BEGIN
  115.       PUTC(NEWLINE);
  116.       COL:=1
  117.     END
  118.     ELSE BEGIN
  119.       PUTC(C);
  120.       COL:=COL+1
  121.     END
  122. END;
  123.  
  124.  
  125.  
  126. PROCEDURE COMMAND;
  127.  
  128. BEGIN
  129.      IF (GlobalArg1='copy') THEN COPY
  130. ELSE IF (GlobalArg1='charcount') THEN CHARCOUNT
  131. ELSE IF (GlobalArg1='linecount') THEN LINECOUNT
  132. ELSE IF (GlobalArg1='wordcount') THEN WORDCOUNT
  133. ELSE IF (GlobalArg1='detab') THEN DETAB
  134. ELSE IF (GlobalArg1='list') THEN listcat
  135. ELSE IF (GlobalArg1='shell') THEN CallShell
  136. ELSE error('Chap 1: can''t happen');
  137. END;(*COMMAND*)
  138.  
  139.  
  140. BEGIN
  141.     command;
  142.     ENDCMD;
  143. END.
  144.